library(tidyverse)
library(patchwork)
library(cowplot)
library(scales)
library(ggpmisc)
library(tidymodels)
library(RColorBrewer)
setwd("C:/Users/s299038/OneDrive - Cranfield University/1. Rapid Measurement Tools - Niall/Chapter 3 - XRF Analysis Accuracy on Slag/Data Analysis/combining for analysis")
element_orders<-read_csv("instrument_elements.csv")
elements_conc<-element_orders$Conc_Order_reverse%>%na.omit()
elements_atomic<-element_orders$Atomic_Order%>%na.omit()
elements_alphabetical<-element_orders$Alphabetic_Order%>%na.omit()
Prosesing_steps<-c("raw","sived","dried","vessile","ground","ignited","ICP")
#load data========
setwd("C:/Users/s299038/OneDrive - Cranfield University/1. Rapid Measurement Tools - Niall/Chapter 3 - XRF Analysis Accuracy on Slag/Data Analysis/combining for analysis")
A_combind_data<-read_csv("combind_data.csv")%>%
mutate(
element = as.factor(element),
element = droplevels(element),
element = fct_expand(element,elements_conc),
element = fct_relevel(element,elements_conc),
)
B_pivoted_data<-read_csv("pivoted_data.csv")%>%
mutate(
element = as.factor(element),
element = droplevels(element),
element = fct_expand(element,elements_conc),
element = fct_relevel(element,elements_conc),
Prosessing_Step = as.factor(Prosessing_Step),
Prosessing_Step = fct_relevel(Prosessing_Step,Prosesing_steps)
)
D_quartile_tabel<-read_csv("quartile_tabel.csv")%>%
mutate(
element = as.factor(element),
element = droplevels(element),
element = fct_expand(element,elements_conc),
element = fct_relevel(element,elements_conc),
Prosessing_Step = as.factor(Prosessing_Step),
Prosessing_Step = fct_relevel(Prosessing_Step,Prosesing_steps)
)
C_filterd_data<-read_csv("filterd_data.csv")%>%
mutate(
element = as.factor(element),
element = droplevels(element),
element = fct_expand(element,elements_conc),
element = fct_relevel(element,elements_conc),
Prosessing_Step = as.factor(Prosessing_Step),
Prosessing_Step = fct_relevel(Prosessing_Step,Prosesing_steps)
)
E_anomalies_kept<-read_csv("anomalies_kept.csv")%>%
mutate(
element = as.factor(element),
element = droplevels(element),
element = fct_expand(element,elements_conc),
element = fct_relevel(element,elements_conc),
Prosessing_Step = as.factor(Prosessing_Step),
Prosessing_Step = fct_relevel(Prosessing_Step,Prosesing_steps)
)
setwd("C:/Users/s299038/OneDrive - Cranfield University/1. Rapid Measurement Tools - Niall/Chapter 3 - XRF Analysis Accuracy on Slag/Data Analysis/Apendix")
tabel_generator<-function(Prosessing_stp = "raw",dataframe = C_filterd_data){
#load data
pivoted_data<-dataframe%>%
filter(Prosessing_Step==Prosessing_stp,
!is.na(mean))
#pivote wide
wide_data<-pivoted_data%>%
pivot_wider(id_cols = ID:Sive_Fraction,
names_from = element,
values_from = mean)
#create vector of elements
elements<-pivoted_data$element%>%
as.factor()%>%
droplevels()%>%
levels()
#forloop to create summary tabel
for (i in 1:length(elements)) {
e<-elements[i]
tb<-wide_data%>%summarise(count=sum(!is.na(get(e))),
min=quantile(get(e),0,na.rm = TRUE),
lower_quantile=quantile(get(e),0.25,na.rm = TRUE),
median=quantile(get(e),0.5,na.rm = TRUE),
mean=mean(get(e),na.rm = TRUE),
upper_quantile=quantile(get(e),0.75,na.rm = TRUE),
max=quantile(get(e),1,na.rm = TRUE))%>%
pivot_longer(cols=everything(),
names_to = "summary",
values_to = e)
if(i==1){
tabels<-list()
tabels[[e]] <- tb
output_tb<-tabels[[i]]
}else if (i==length(elements)){
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
transpose_tibble<-function(tibble){
tibble%>%
rename(rowname=1)%>%
mutate(across(everything(),~as.character(.)))%>%
pivot_longer(cols = !rowname ,names_to = 'variable',  values_to = 'value') %>%
pivot_wider(id_cols = variable, names_from = rowname, values_from = value)%>%
type.convert(as.is=TRUE)
}
tb<-tibble(variable = elements_atomic,
n=seq(1:12))
output_tb<-transpose_tibble(output_tb)%>%
full_join(tb,raw_summery,by = "variable")%>%
arrange(n)%>%
select(!n)%>%
rename(element=variable)
}else{
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
}
}
output_tb
}
#filtered tabels
raw_summery<-tabel_generator(Prosessing_stp = "raw")
sived_summery<-tabel_generator("sived")
dried_summery<-tabel_generator("dried")
vessile_summery<-tabel_generator("vessile")
ground_summery<-tabel_generator("ground")
ignited_summery<-tabel_generator("sived")
ICP_summery<-tabel_generator("ICP")
#unfiltered tabels
raw_summery<-tabel_generator(Prosessing_stp = "raw",dataframe = B_pivoted_data)
sived_summery<-tabel_generator("sived",dataframe = B_pivoted_data)
dried_summery<-tabel_generator("dried",dataframe = B_pivoted_data)
vessile_summery<-tabel_generator("vessile",dataframe = B_pivoted_data)
ground_summery<-tabel_generator("ground",dataframe = B_pivoted_data)
ignited_summery<-tabel_generator("sived",dataframe = B_pivoted_data)
ICP_summery<-tabel_generator("ICP",dataframe = B_pivoted_data)
tabel_generator<-function(Prosessing_stp = "raw",dataframe = C_filterd_data){
#load data
pivoted_data<-dataframe%>%
filter(Prosessing_Step==Prosessing_stp,
!is.na(mean))%>%
mutate(matrix==as.factor(matrix))
#pivote wide
wide_data<-pivoted_data%>%
pivot_wider(id_cols = ID:matrix,
names_from = element,
values_from = mean)
#create vector of elements
elements<-pivoted_data$element%>%
as.factor()%>%
droplevels()%>%
levels()
#forloop to create summary tabel
for (i in 1:length(elements)) {
e<-elements[i]
tb<-wide_data%>%group_by(Depth)%>%
summarise(count=sum(!is.na(get(e))),
min=quantile(get(e),0,na.rm = TRUE),
lower_quantile=quantile(get(e),0.25,na.rm = TRUE),
median=quantile(get(e),0.5,na.rm = TRUE),
mean=mean(get(e),na.rm = TRUE),
upper_quantile=quantile(get(e),0.75,na.rm = TRUE),
max=quantile(get(e),1,na.rm = TRUE))%>%
pivot_wider(names_from = Depth, names_sep = ".", values_from = count:max,)%>%
pivot_longer(cols=everything(),
names_to = "summary",
values_to = e)
if(i==1){
tabels<-list()
tabels[[e]] <- tb
output_tb<-tabels[[i]]
}else if (i==length(elements)){
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
transpose_tibble<-function(tibble){
tibble%>%
rename(rowname=1)%>%
mutate(across(everything(),~as.character(.)))%>%
pivot_longer(cols = !rowname ,names_to = 'variable',  values_to = 'value') %>%
pivot_wider(id_cols = variable, names_from = rowname, values_from = value)%>%
type.convert(as.is=TRUE)
}
tb<-tibble(variable = elements_atomic,
n=seq(1:12))
output_tb<-transpose_tibble(output_tb)%>%
full_join(tb,raw_summery,by = "variable")%>%
arrange(n)%>%
select(!n)%>%
rename(element=variable)
}else{
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
}
}
output_tb
}
#depth tabels
raw_summery<-tabel_generator(Prosessing_stp = "raw")
sived_summery<-tabel_generator("sived")
dried_summery<-tabel_generator("dried")
vessile_summery<-tabel_generator("vessile")
ground_summery<-tabel_generator("ground")
ignited_summery<-tabel_generator("sived")
ICP_summery<-tabel_generator("ICP")
tabel_generator<-function(Prosessing_stp = "raw",dataframe = C_filterd_data){
#load data
pivoted_data<-dataframe%>%
filter(Prosessing_Step==Prosessing_stp,
!is.na(mean))%>%
mutate(matrix==as.factor(matrix))
#pivote wide
wide_data<-pivoted_data%>%
pivot_wider(id_cols = ID:matrix,
names_from = element,
values_from = mean)
#create vector of elements
elements<-pivoted_data$element%>%
as.factor()%>%
droplevels()%>%
levels()
#forloop to create summary tabel
for (i in 1:length(elements)) {
e<-elements[i]
tb<-wide_data%>%group_by(matrix)%>%
summarise(count=sum(!is.na(get(e))),
min=quantile(get(e),0,na.rm = TRUE),
lower_quantile=quantile(get(e),0.25,na.rm = TRUE),
median=quantile(get(e),0.5,na.rm = TRUE),
mean=mean(get(e),na.rm = TRUE),
upper_quantile=quantile(get(e),0.75,na.rm = TRUE),
max=quantile(get(e),1,na.rm = TRUE))%>%
pivot_wider(names_from = matrix, names_sep = ".", values_from = count:max,)%>%
pivot_longer(cols=everything(),
names_to = "summary",
values_to = e)
if(i==1){
tabels<-list()
tabels[[e]] <- tb
output_tb<-tabels[[i]]
}else if (i==length(elements)){
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
transpose_tibble<-function(tibble){
tibble%>%
rename(rowname=1)%>%
mutate(across(everything(),~as.character(.)))%>%
pivot_longer(cols = !rowname ,names_to = 'variable',  values_to = 'value') %>%
pivot_wider(id_cols = variable, names_from = rowname, values_from = value)%>%
type.convert(as.is=TRUE)
}
tb<-tibble(variable = elements_atomic,
n=seq(1:12))
output_tb<-transpose_tibble(output_tb)%>%
full_join(tb,raw_summery,by = "variable")%>%
arrange(n)%>%
select(!n)%>%
rename(element=variable)
}else{
tabels[[e]] <- tb
output_tb<-output_tb%>%
full_join(tabels[[i]],by="summary")
}
}
output_tb
}
#matrix tabels
raw_summery<-tabel_generator(Prosessing_stp = "raw")
sived_summery<-tabel_generator("sived")
dried_summery<-tabel_generator("dried")
vessile_summery<-tabel_generator("vessile")
ground_summery<-tabel_generator("ground")
ignited_summery<-tabel_generator("sived")
ICP_summery<-tabel_generator("ICP")
